home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / memory.swg / 0021_BIG Arrays on the HEAP.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  3.5 KB  |  123 lines
  1. {
  2. SEPP MAYER
  3.  
  4. > Unfortunately I can't cut down on the size of my variables...(well,
  5. > ok, one  of them I did, but it drastically reduces the usefulness of
  6. > the program  itself).  So now I got rid of it, but one of my variables
  7. > is of Array  [1..1000] Of String[12].  I'd like to have the array go to
  8. > 2500.   Unfortunately, when I do this, it gives me the error.  Is there
  9. > some way to  get around that??
  10.  
  11. At the Time your Array uses 13000 Byte of Memory in the Data-Segment
  12. (12 Byte for the 12 characters in the string + 1 Byte for the Length).
  13.  
  14. The Only Thing You have to do, is to put your Array to the Heap, so you
  15. can have an Array[1..3250] of your String with the same Use of Memory in
  16. your Data-Segment.
  17. }
  18.  
  19. program BigArray;
  20.  
  21. type
  22.   PStr12 = ^TStr12;
  23.   tStr12 = String[12];
  24.  
  25. var
  26.   TheTab : Array[1..3250] of PStr12;
  27.   i      : Integer;
  28.  
  29. function AddTabEle(i : Integer; s : String) : Boolean;
  30. begin
  31.   if i < 1 then
  32.   begin
  33.     WriteLn('You Used an Index lower than 1');
  34.     AddTabEle := false;
  35.     Exit;
  36.   end;
  37.   if i > 3250 then
  38.   begin
  39.     WriteLn('You Used an Index higher then 3250');
  40.     AddTabEle := false;
  41.     Exit;
  42.   end;
  43.   if TheTab[i] <> nil then
  44.   begin
  45.     WriteLn('TAB Element is already in Use');
  46.     AddTabEle := false;
  47.     Exit;
  48.   end;
  49.   if MemAvail < 13 then
  50.   begin
  51.     WriteLn('Not Enough Heap Memory');
  52.     AddTabEle := false;
  53.     Exit;
  54.   end;
  55.   New[TheTab[i]);
  56.   TheTab[i]^ := Copy(s,1,12); {Limit to 12 Characters}
  57.   AddTabEle  := true;
  58. end;
  59.  
  60. function ChangeTabEle(i : integer; s : string) : Boolean;
  61. begin
  62.   if TheTab[i] = nil then
  63.   begin
  64.     WriteLn('You Tried to Modify an non-existing TAB Element, Use AddTabEle');
  65.     ChangeTabEle := false;
  66.     Exit;
  67.   end;
  68.   TheTab[i]^   := Copy(s, 1, 12);
  69.   ChangeTabEle := true;
  70. end;
  71.  
  72. function GetTabEle(i : integer) : string;
  73. begin
  74.   if TheTab[i] = nil then
  75.   begin
  76.     GetTabEle := 'TAB Ele not found'; {No error occurs}
  77.     Exit;
  78.   end;
  79.   s := TheTab[i]^;
  80. end;
  81. function FreeTabEle(i : integer) : Boolean;
  82. begin
  83.   if TheTab[i] = nil then
  84.   begin
  85.     WriteLn('TAB Element is not used';
  86.     FreeTabEle := false;
  87.     Exit;
  88.   end;
  89.   Dispose(TheTab[i]);
  90.   TheTab[i]  := nil;
  91.   FreeTabEle := true;
  92. end;
  93.  
  94. procedure FreeTab;
  95. begin
  96.   for i := 1 to 3250 do
  97.   begin
  98.     if TheTab[i] <> nil then
  99.       if NOT FreeTabEle(i) then
  100.         WriteLn('Error releasing Tab element');
  101.   end;
  102. end;
  103.  
  104. begin
  105.   for i := 1 to 3250 do       {Initialize Pointers with nil, to test       }
  106.     TheTab[i] := nil;         {if Element is Used, compare pointer with nil}
  107.   {.......}                   {Your Program}
  108.   if NOT AddTabEle(1, 'Max 12 Chars') then  {Add an Ele}
  109.     WriteLn('Error creating TAB element');  {evtl. use FreeMem + Halt(1)}
  110.                                             {to terminate Programm}
  111.   WriteLn(GetTabEle(1));                    {Write an Tab Ele}
  112.   if NOT ChangeTabEle(1, '12 Chars Max') then {Change an Ele}
  113.     WriteLn('Error changing TAB element');  {evtl. use FreeMem + Halt(1)}
  114.                                             {to terminate Programm}
  115.   WriteLn(GetTabEle(1));                    {Write an Tab Ele}
  116.   if NOT FreeTabEle(1) then                 {Delete(Free) an Ele}
  117.     WriteLn('Error releasing Tab element'); {evtl. use FreeMem + Halt(1)}
  118.                                             {to terminate Programm}
  119.   {.......}                   {Your Program}
  120.   FreeTab;                    {At The End of Your Program free all TAB Ele}
  121. end.
  122.  
  123.